home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / ODE / circular < prev    next >
Encoding:
Text File  |  1991-10-24  |  1.8 KB  |  103 lines
  1. \ Circular Buffer for FIFO queue.
  2. \
  3. \ New values will be added to the circular buffer
  4. \ using ADD: and read out using NEXT:
  5. \
  6. \ An error message will be printed if too many values
  7. \ are added or removed.
  8. \
  9. \ Author: Phil Burk
  10. \ Copyright 1987 Phil Burk, Larry Polansky, David Rosenboom
  11. \
  12. \ MOD: PLB 11/18/87 Use IV-CIRC-MANY for housekeeping.
  13.  
  14. EXISTS? OB.ELMNTS NOT .IF
  15.     MRESET ADD:
  16. .THEN
  17.  
  18. ANEW TASK-CIRCULAR
  19.  
  20. .NEED ADD:
  21. METHOD ADD:
  22. METHOD NEXT:
  23. METHOD MANY:
  24. .THEN
  25.  
  26. :CLASS OB.CIRCULAR <SUPER  OB.ARRAY
  27.     IV.LONG IV-CIRC-WRITE  ( points to next empty hole )
  28.     IV.LONG IV-CIRC-READ   ( points to first unread value )
  29.         IV.LONG IV-CIRC-MANY
  30.  
  31. :M MANY:  ( -- number_values , number of values in buffer )
  32.     iv-circ-many
  33. ;M
  34.  
  35. :M CLEAR: ( -- )
  36.     0 iv=> iv-circ-write
  37.     0 iv=> iv-circ-read
  38.     0 iv=> iv-circ-many
  39. ;M
  40.  
  41. :M NEW: ( #elements -- )
  42.     new: super
  43.     clear: self
  44. ;M
  45.  
  46. :M ADD: ( value -- , add to FIFO queue )
  47.     iv-circ-write dup iv-#cells <
  48.     IF  to.self
  49.         1 iv+> iv-circ-write
  50.     ELSE drop 0 to.self
  51.         1 iv=> iv-circ-write
  52.     THEN
  53.     1 iv+> iv-circ-many
  54.     iv-circ-many iv-#cells >
  55.     IF " ADD: OB.CIRCULAR" " Too much data in circular buffer!"
  56.         er_return ob.report.error
  57.     THEN
  58. ;M
  59.  
  60. :M NEXT: ( -- value , get next value from FIFO )
  61.     iv-circ-read dup iv-#cells =
  62.     IF drop 0 0 iv=> iv-circ-read
  63.     THEN
  64.     at.self
  65.     -1 iv+> iv-circ-many
  66.     iv-circ-many 0<
  67.     IF " NEXT: OB.CIRCULAR" " Attempt to get more data than there is!"
  68.         er_return ob.report.error
  69.     ELSE
  70.         1 iv+> iv-circ-read
  71.     THEN
  72. ;M
  73.  
  74. :M PRINT: ( -- )
  75.     cr many: self 0 max 0
  76.     DO  i iv-circ-read + iv-#cells mod
  77.         dup . self at: [] . cr
  78.         ?pause
  79.     LOOP
  80. ;M
  81.  
  82. ;CLASS
  83.  
  84. if-testing @ .IF
  85. OB.CIRCULAR CIRC-1
  86. : TEST.CIRC
  87.     8 new: circ-1
  88.     0 add: circ-1 0
  89.     50 1
  90.     DO i add: circ-1 i
  91.         many: circ-1 2 -
  92.         IF ." MANY: doesn't work! = " many: circ-1 . cr
  93.         THEN
  94.         next: circ-1 rot .s = NOT
  95.         IF ." Bad Value!"
  96.         THEN
  97.         ?pause
  98.     LOOP
  99.     drop
  100.     free: circ-1
  101. ;
  102. .THEN
  103.